home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src / tclXkeylist.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  26.4 KB  |  858 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCLExtend
  3. #endif
  4. /* 
  5.  * tclXkeylist.c --
  6.  *
  7.  *  Extended Tcl keyed list commands and interfaces.
  8.  *-----------------------------------------------------------------------------
  9.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  10.  *
  11.  * Permission to use, copy, modify, and distribute this software and its
  12.  * documentation for any purpose and without fee is hereby granted, provided
  13.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14.  * Mark Diekhans make no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without express or
  16.  * implied warranty.
  17.  *-----------------------------------------------------------------------------
  18.  * $Id: tclXkeylist.c,v 2.4 1993/07/18 05:59:41 markd Exp $
  19.  *-----------------------------------------------------------------------------
  20.  */
  21.  
  22. #include "tclExtdInt.h"
  23.  
  24. /*
  25.  * Type used to return information about a field that was found in a keyed
  26.  * list.
  27.  */
  28. typedef struct fieldInfo_t {
  29.         int    argc;
  30.         char **argv;
  31.         int    foundIdx;
  32.         char  *valuePtr;
  33.         int    valueSize;
  34.         } fieldInfo_t;
  35.  
  36. /*
  37.  * Prototypes of internal functions.
  38.  */
  39. static int
  40. CompareKeyListField _ANSI_ARGS_((Tcl_Interp   *interp,
  41.                                  CONST char   *fieldName,
  42.                                  CONST char   *field,
  43.                                  char        **valuePtr,
  44.                                  int          *valueSizePtr,
  45.                                  int          *bracedPtr));
  46.  
  47. static int
  48. SplitAndFindField _ANSI_ARGS_((Tcl_Interp  *interp,
  49.                                CONST char  *fieldName,
  50.                                CONST char  *keyedList,
  51.                                fieldInfo_t *fieldInfoPtr));
  52.  
  53.  
  54. /*
  55.  *-----------------------------------------------------------------------------
  56.  *
  57.  * CompareKeyListField --
  58.  *   Compare a field name to a field (keyword/value pair) to determine if
  59.  * the field names match.
  60.  *
  61.  * Parameters:
  62.  *   o interp (I/O) - Error message will be return in result if there is an
  63.  *     error.
  64.  *   o fieldName (I) - Field name to compare against field.
  65.  *   o field (I) - Field to see if its name matches.
  66.  *   o valuePtr (O) - If the field names match, a pointer to value part is
  67.  *     returned.
  68.  *   o valueSizePtr (O) - If the field names match, the length of the value
  69.  *     part is returned here.
  70.  *   o bracedPtr (O) - If the field names match, non-zero/zero to inficate
  71.  *     that the value was/warn't in braces.
  72.  * Returns:
  73.  *    TCL_OK - If the field names match.
  74.  *    TCL_BREAK - If the fields names don't match.
  75.  *    TCL_ERROR -  If the list has an invalid format.
  76.  *-----------------------------------------------------------------------------
  77.  */
  78. static int
  79. CompareKeyListField (interp, fieldName, field, valuePtr, valueSizePtr,
  80.                      bracedPtr)
  81.     Tcl_Interp   *interp;
  82.     CONST char   *fieldName;
  83.     CONST char   *field;
  84.     char        **valuePtr;
  85.     int          *valueSizePtr; 
  86.     int          *bracedPtr;
  87. {
  88.     char *elementPtr, *nextPtr;
  89.     int   fieldNameSize, elementSize;
  90.  
  91.     if (field [0] == '\0') {
  92.         interp->result =
  93.             "invalid keyed list format: list contains an empty field entry";
  94.         return TCL_ERROR;
  95.     }
  96.     if (TclFindElement (interp, (char *) field, &elementPtr, &nextPtr, 
  97.                         &elementSize, NULL) != TCL_OK)
  98.         return TCL_ERROR;
  99.     if (elementSize == 0) {
  100.         interp->result =
  101.             "invalid keyed list format: list contains an empty field name";
  102.         return TCL_ERROR;
  103.     }
  104.     if (nextPtr[0] == '\0') {
  105.         Tcl_AppendResult (interp, "invalid keyed list format or inconsistent ",
  106.                           "field name scoping: no value associated with ",
  107.                           "field \"", elementPtr, "\"", (char *) NULL);
  108.         return TCL_ERROR;
  109.     }
  110.  
  111.     fieldNameSize = strlen ((char *) fieldName);
  112.     if (!((elementSize == fieldNameSize) && 
  113.             STRNEQU (elementPtr, ((char *) fieldName), fieldNameSize)))
  114.         return TCL_BREAK;   /* Names do not match */
  115.  
  116.     /*
  117.      * Extract the value from the list.
  118.      */
  119.     if (TclFindElement (interp, nextPtr, &elementPtr, &nextPtr, &elementSize, 
  120.                         bracedPtr) != TCL_OK)
  121.         return TCL_ERROR;
  122.     if (nextPtr[0] != '\0') {
  123.         Tcl_AppendResult (interp, "invalid keyed list format: ",
  124.                           "trailing data following value in field: \"",
  125.                           elementPtr, "\"", (char *) NULL);
  126.         return TCL_ERROR;
  127.     }
  128.     *valuePtr = elementPtr;
  129.     *valueSizePtr = elementSize;
  130.     return TCL_OK;
  131. }
  132.  
  133. /*
  134.  *-----------------------------------------------------------------------------
  135.  *
  136.  * SplitAndFindField --
  137.  *   Split a keyed list into an argv and locate a field (key/value pair)
  138.  * in the list.
  139.  *
  140.  * Parameters:
  141.  *   o interp (I/O) - Error message will be return in result if there is an
  142.  *     error.
  143.  *   o fieldName (I) - The name of the field to find.  Will validate that the
  144.  *     name is not empty.  If the name has a sub-name (seperated by "."),
  145.  *     search for the top level name.
  146.  *   o fieldInfoPtr (O) - The following fields are filled in:
  147.  *       o argc - The number of elements in the keyed list.
  148.  *       o argv - The keyed list argv is returned here, even if the key was
  149.  *         not found.  Client must free.  Will be NULL is an error occurs.
  150.  *       o foundIdx - The argv index containing the list entry that matches
  151.  *         the field name, or -1 if the key was not found.
  152.  *       o valuePtr - Pointer to the value part of the found element. NULL
  153.  *         in not found.
  154.  *       o valueSize - The size of the value part.
  155.  * Returns:
  156.  *   Standard Tcl result.
  157.  *-----------------------------------------------------------------------------
  158.  */
  159. static int
  160. SplitAndFindField (interp, fieldName, keyedList, fieldInfoPtr)
  161.     Tcl_Interp  *interp;
  162.     CONST char  *fieldName;
  163.     CONST char  *keyedList;
  164.     fieldInfo_t *fieldInfoPtr;
  165. {
  166.     int  idx, result, braced;
  167.  
  168.     if (fieldName == '\0') {
  169.         interp->result = "null key not allowed";
  170.         return TCL_ERROR;
  171.     }
  172.  
  173.     fieldInfoPtr->argv = NULL;
  174.  
  175.     if (Tcl_SplitList (interp, (char *) keyedList, &fieldInfoPtr->argc,
  176.                        &fieldInfoPtr->argv) != TCL_OK)
  177.         goto errorExit;
  178.  
  179.     result = TCL_BREAK;
  180.     for (idx = 0; idx < fieldInfoPtr->argc; idx++) {
  181.         result = CompareKeyListField (interp, fieldName, 
  182.                                       fieldInfoPtr->argv [idx],
  183.                                       &fieldInfoPtr->valuePtr,
  184.                                       &fieldInfoPtr->valueSize,
  185.                                       &braced);
  186.         if (result != TCL_BREAK)
  187.             break;  /* Found or error, exit before idx is incremented. */
  188.     }
  189.     if (result == TCL_ERROR)
  190.         goto errorExit;
  191.  
  192.     if (result == TCL_BREAK) {
  193.         fieldInfoPtr->foundIdx = -1;  /* Not found */
  194.         fieldInfoPtr->valuePtr = NULL;
  195.     } else {
  196.         fieldInfoPtr->foundIdx = idx;
  197.     }
  198.     return TCL_OK;
  199.  
  200. errorExit:
  201.     if (fieldInfoPtr->argv != NULL)
  202.         ckfree (fieldInfoPtr->argv);
  203.     fieldInfoPtr->argv = NULL;
  204.     return TCL_ERROR;
  205. }
  206.  
  207. /*
  208.  *-----------------------------------------------------------------------------
  209.  *
  210.  * Tcl_GetKeyedListKeys --
  211.  *   Retrieve a list of keyes from a keyed list.  The list is walked rather
  212.  * than converted to a argv for increased performance.
  213.  *
  214.  * Parameters:
  215.  *   o interp (I/O) - Error message will be return in result if there is an
  216.  *     error.
  217.  *   o subFieldName (I) - If "" or NULL, then the keys are retreved for
  218.  *     the top level of the list.  If specified, it is name of the field who's
  219.  *     subfield keys are to be retrieve.
  220.  *   o keyedList (I) - The list to search for the field.
  221.  *   o keyesArgcPtr (O) - The number of keys in the keyed list is returned
  222.  *     here.
  223.  *   o keyesArgvPtr (O) - An argv containing the key names.  It is dynamically
  224.  *     allocated, containing both the array and the strings. A single call
  225.  *     to ckfree will release it.
  226.  * Returns:
  227.  *   TCL_OK - If the field was found.
  228.  *   TCL_BREAK - If the field was not found.
  229.  *   TCL_ERROR - If an error occured.
  230.  *-----------------------------------------------------------------------------
  231.  */
  232. int
  233. Tcl_GetKeyedListKeys (interp, subFieldName, keyedList, keyesArgcPtr,
  234.                       keyesArgvPtr)
  235.     Tcl_Interp  *interp;
  236.     CONST char  *subFieldName;
  237.     CONST char  *keyedList;
  238.     int         *keyesArgcPtr;
  239.     char      ***keyesArgvPtr;
  240. {
  241.     char  *scanPtr, *subFieldList;
  242.     int    result, keyCount, totalKeySize, idx;
  243.     char  *fieldPtr, *keyPtr, *nextByte, *dummyPtr;
  244.     int    fieldSize,  keySize;
  245.     char **keyArgv;
  246.  
  247.     /*
  248.      * If the keys of a subfield are requested, the dig out that field's
  249.      * list and then rummage through in getting the keys.
  250.      */
  251.     subFieldList = NULL;
  252.     if ((subFieldName != NULL) && (subFieldName [0] != '\0')) {
  253.         result = Tcl_GetKeyedListField (interp, subFieldName, keyedList,
  254.                                         &subFieldList);
  255.         if (result != TCL_OK)
  256.             return result;
  257.         keyedList = subFieldList;
  258.     }
  259.  
  260.     /*
  261.      * Walk the list count the number of field names and their length.
  262.      */
  263.     keyCount = 0;
  264.     totalKeySize = 0;    
  265.     scanPtr = (char *) keyedList;
  266.  
  267.     while (*scanPtr != '\0') {
  268.         result = TclFindElement (interp, scanPtr, &fieldPtr, &scanPtr, 
  269.                                  &fieldSize, NULL);
  270.         if (result != TCL_OK)
  271.             goto errorExit;
  272.         result = TclFindElement (interp, fieldPtr, &keyPtr, &dummyPtr,
  273.                                  &keySize, NULL);
  274.         if (result != TCL_OK)
  275.             goto errorExit;
  276.  
  277.         keyCount++;
  278.         totalKeySize += keySize + 1;
  279.     }
  280.  
  281.     /*
  282.      * Allocate a structure to hold both the argv and strings.
  283.      */
  284.     keyArgv = (char **) ckalloc (((keyCount + 1) * sizeof (char *)) +
  285.                                  totalKeySize);
  286.     keyArgv [keyCount] = NULL;
  287.     nextByte = ((char *) keyArgv) + ((keyCount + 1) * sizeof (char *));
  288.  
  289.     /*
  290.      * Walk the list once more, copying in the strings and building up the
  291.      * argv.
  292.      */
  293.     scanPtr = (char *) keyedList;
  294.     idx = 0;
  295.  
  296.     while (*scanPtr != '\0') {
  297.         TclFindElement (interp, scanPtr, &fieldPtr, &scanPtr, &fieldSize,
  298.                         NULL);
  299.         TclFindElement (interp, fieldPtr, &keyPtr, &dummyPtr, &keySize, NULL);
  300.         keyArgv [idx++] = nextByte;
  301.         strncpy (nextByte, keyPtr, keySize);
  302.         nextByte [keySize] = '\0';
  303.         nextByte += keySize + 1; 
  304.     }
  305.     *keyesArgcPtr = keyCount;
  306.     *keyesArgvPtr = keyArgv;
  307.     
  308.     if (subFieldList != NULL)
  309.         ckfree (subFieldList);
  310.     return TCL_OK;
  311.  
  312.   errorExit:
  313.     if (subFieldList != NULL)
  314.         ckfree (subFieldList);
  315.     return TCL_ERROR;
  316. }
  317.  
  318. /*
  319.  *-----------------------------------------------------------------------------
  320.  *
  321.  * Tcl_GetKeyedListField --
  322.  *   Retrieve a field value from a keyed list.  The list is walked rather than
  323.  * converted to a argv for increased performance.  This if the name contains
  324.  * sub-fields, this function recursive.
  325.  *
  326.  * Parameters:
  327.  *   o interp (I/O) - Error message will be return in result if there is an
  328.  *     error.
  329.  *   o fieldName (I) - The name of the field to extract.  Will recusively
  330.  *     process sub-field names seperated by `.'.
  331.  *   o keyedList (I) - The list to search for the field.
  332.  *   o fieldValuePtr (O) - If the field is found, a pointer to a dynamicly
  333.  *     allocated string containing the value is returned here.  If NULL is
  334.  *     specified, then only the presence of the field is validated, the
  335.  *     value is not returned.
  336.  * Returns:
  337.  *   TCL_OK - If the field was found.
  338.  *   TCL_BREAK - If the field was not found.
  339.  *   TCL_ERROR - If an error occured.
  340.  *-----------------------------------------------------------------------------
  341.  */
  342. int
  343. Tcl_GetKeyedListField (interp, fieldName, keyedList, fieldValuePtr)
  344.     Tcl_Interp  *interp;
  345.     CONST char  *fieldName;
  346.     CONST char  *keyedList;
  347.     char       **fieldValuePtr;
  348. {
  349.     char *nameSeparPtr, *scanPtr, *valuePtr;
  350.     int   valueSize, result, braced;
  351.  
  352.     if (fieldName == '\0') {
  353.         interp->result = "null key not allowed";
  354.         return TCL_ERROR;
  355.     }
  356.  
  357.     /*
  358.      * Check for sub-names, temporarly delimit the top name with a '\0'.
  359.      */
  360.     nameSeparPtr = strchr ((char *) fieldName, '.');
  361.     if (nameSeparPtr != NULL)
  362.         *nameSeparPtr = '\0';
  363.  
  364.     /*
  365.      * Walk the list looking for a field name that matches.
  366.      */
  367.     scanPtr = (char *) keyedList;
  368.     result = TCL_BREAK;   /* Assume not found */
  369.  
  370.     while (*scanPtr != '\0') {
  371.         char *fieldPtr;
  372.         int   fieldSize;
  373.         char  saveChar;
  374.  
  375.         result = TclFindElement (interp, scanPtr, &fieldPtr, &scanPtr, 
  376.                                  &fieldSize, NULL);
  377.         if (result != TCL_OK)
  378.             break;
  379.  
  380.         saveChar = fieldPtr [fieldSize];
  381.         fieldPtr [fieldSize] = '\0';
  382.  
  383.         result = CompareKeyListField (interp, (char *) fieldName, fieldPtr,
  384.                                       &valuePtr, &valueSize, &braced);
  385.         fieldPtr [fieldSize] = saveChar;
  386.         if (result != TCL_BREAK)
  387.             break;  /* Found or an error */
  388.     }
  389.  
  390.     if (result != TCL_OK)
  391.         goto exitPoint;   /* Not found or an error */
  392.  
  393.     /*
  394.      * If a subfield is requested, recurse to get the value otherwise allocate
  395.      * a buffer to hold the value.
  396.      */
  397.     if (nameSeparPtr != NULL) {
  398.         char  saveChar;
  399.  
  400.         saveChar = valuePtr [valueSize];
  401.         valuePtr [valueSize] = '\0';
  402.         result = Tcl_GetKeyedListField (interp, nameSeparPtr+1, valuePtr, 
  403.                                         fieldValuePtr);
  404.         valuePtr [valueSize] = saveChar;
  405.     } else {
  406.         if (fieldValuePtr != NULL) {
  407.             char *fieldValue;
  408.  
  409.             fieldValue = ckalloc (valueSize + 1);
  410.           if (braced)  {
  411.               strncpy (fieldValue, valuePtr, valueSize);
  412.               fieldValue [valueSize] = '\0';
  413.           } else {
  414.               TclCopyAndCollapse(valueSize, valuePtr, fieldValue);
  415.           }
  416.             *fieldValuePtr = fieldValue;
  417.         }
  418.     }
  419. exitPoint:
  420.     if (nameSeparPtr != NULL)
  421.          *nameSeparPtr = '.';
  422.     return result;
  423. }
  424.  
  425. /*
  426.  *-----------------------------------------------------------------------------
  427.  *
  428.  * Tcl_SetKeyedListField --
  429.  *   Set a field value in keyed list.
  430.  *
  431.  * Parameters:
  432.  *   o interp (I/O) - Error message will be return in result if there is an
  433.  *     error.
  434.  *   o fieldName (I) - The name of the field to extract.  Will recusively
  435.  *     process sub-field names seperated by `.'.
  436.  *   o fieldValue (I) - The value to set for the field.
  437.  *   o keyedList (I) - The keyed list to set a field value in, may be an
  438.  *     NULL or an empty list to create a new keyed list.
  439.  * Returns:
  440.  *   A pointer to a dynamically allocated string, or NULL if an error
  441.  *   occured.
  442.  *-----------------------------------------------------------------------------
  443.  */
  444. char *
  445. Tcl_SetKeyedListField (interp, fieldName, fieldValue, keyedList)
  446.     Tcl_Interp  *interp;
  447.     CONST char  *fieldName;
  448.     CONST char  *fieldValue;
  449.     CONST char  *keyedList;
  450. {
  451.     char        *nameSeparPtr;
  452.     char        *newField = NULL, *newList;
  453.     fieldInfo_t  fieldInfo;
  454.     char        *elemArgv [2];
  455.  
  456.     if (keyedList == NULL)
  457.         keyedList = "";
  458.  
  459.     /*
  460.      * Check for sub-names, temporarly delimit the top name with a '\0'.
  461.      */
  462.     nameSeparPtr = strchr ((char *) fieldName, '.');
  463.     if (nameSeparPtr != NULL)
  464.         *nameSeparPtr = '\0';
  465.  
  466.     if (SplitAndFindField (interp, fieldName, keyedList, &fieldInfo) != TCL_OK)
  467.         goto errorExit;
  468.  
  469.     /*
  470.      * Either recursively retrieve build the field value or just use the
  471.      * supplied value.
  472.      */
  473.     elemArgv [0] = (char *) fieldName;
  474.     if (nameSeparPtr != NULL) {
  475.         char saveChar;
  476.  
  477.         if (fieldInfo.valuePtr != NULL) {
  478.             saveChar = fieldInfo.valuePtr [fieldInfo.valueSize];
  479.             fieldInfo.valuePtr [fieldInfo.valueSize] = '\0';
  480.         }
  481.         elemArgv [1] = Tcl_SetKeyedListField (interp, nameSeparPtr+1,
  482.                                               fieldValue, fieldInfo.valuePtr);
  483.  
  484.         if (fieldInfo.valuePtr != NULL)
  485.             fieldInfo.valuePtr [fieldInfo.valueSize] = saveChar;
  486.         if (elemArgv [1] == NULL)
  487.             goto errorExit;
  488.         newField = Tcl_Merge (2, elemArgv);
  489.         ckfree (elemArgv [1]);
  490.     } else {
  491.         elemArgv [1] = (char *) fieldValue;
  492.         newField = Tcl_Merge (2, elemArgv);
  493.     }
  494.  
  495.     /*
  496.      * If the field does not current exist in the keyed list, append it,
  497.      * otherwise replace it.
  498.      */
  499.     if (fieldInfo.foundIdx == -1) {
  500.         fieldInfo.foundIdx = fieldInfo.argc;
  501.         fieldInfo.argc++;
  502.     }
  503.  
  504.     fieldInfo.argv [fieldInfo.foundIdx] = newField;
  505.     newList = Tcl_Merge (fieldInfo.argc, fieldInfo.argv);
  506.  
  507.     if (nameSeparPtr != NULL)
  508.          *nameSeparPtr = '.';
  509.     ckfree ((char *) newField);
  510.     ckfree ((char *) fieldInfo.argv);
  511.     return newList;
  512.  
  513. errorExit:
  514.     if (nameSeparPtr != NULL)
  515.          *nameSeparPtr = '.';
  516.     if (newField != NULL)
  517.         ckfree ((char *) newField);
  518.     if (fieldInfo.argv != NULL)
  519.         ckfree ((char *) fieldInfo.argv);
  520.     return NULL;
  521. }
  522.  
  523. /*
  524.  *-----------------------------------------------------------------------------
  525.  *
  526.  * Tcl_DeleteKeyedListField --
  527.  *   Delete a field value in keyed list.
  528.  *
  529.  * Parameters:
  530.  *   o interp (I/O) - Error message will be return in result if there is an
  531.  *     error.
  532.  *   o fieldName (I) - The name of the field to extract.  Will recusively
  533.  *     process sub-field names seperated by `.'.
  534.  *   o fieldValue (I) - The value to set for the field.
  535.  *   o keyedList (I) - The keyed list to delete the field from.
  536.  * Returns:
  537.  *   A pointer to a dynamically allocated string containing the new list, or
  538.  *   NULL if an error occured.
  539.  *-----------------------------------------------------------------------------
  540.  */
  541. char *
  542. Tcl_DeleteKeyedListField (interp, fieldName, keyedList)
  543.     Tcl_Interp  *interp;
  544.     CONST char  *fieldName;
  545.     CONST char  *keyedList;
  546. {
  547.     char        *nameSeparPtr;
  548.     char        *newList;
  549.     int          idx;
  550.     fieldInfo_t  fieldInfo;
  551.     char        *elemArgv [2];
  552.     char        *newElement;
  553.     /*
  554.      * Check for sub-names, temporarly delimit the top name with a '\0'.
  555.      */
  556.     nameSeparPtr = strchr ((char *) fieldName, '.');
  557.     if (nameSeparPtr != NULL)
  558.         *nameSeparPtr = '\0';
  559.  
  560.     if (SplitAndFindField (interp, fieldName, keyedList, &fieldInfo) != TCL_OK)
  561.         goto errorExit;
  562.  
  563.     if (fieldInfo.foundIdx == -1) {
  564.         Tcl_AppendResult (interp, "field name not found: \"",  fieldName,
  565.                           "\"", (char *) NULL);
  566.         goto errorExit;
  567.     }
  568.  
  569.     /*
  570.      * If sub-field, recurse down to find the field to delete. If empty field
  571.      * returned or no sub-field, delete the found entry by moving everything
  572.      * up in the argv.
  573.      */
  574.     elemArgv [0] = (char *) fieldName;
  575.     if (nameSeparPtr != NULL) {
  576.         char saveChar;
  577.  
  578.         if (fieldInfo.valuePtr != NULL) {
  579.             saveChar = fieldInfo.valuePtr [fieldInfo.valueSize];
  580.             fieldInfo.valuePtr [fieldInfo.valueSize] = '\0';
  581.         }
  582.         elemArgv [1] = Tcl_DeleteKeyedListField (interp, nameSeparPtr+1, 
  583.                                                  fieldInfo.valuePtr);
  584.         if (fieldInfo.valuePtr != NULL)
  585.             fieldInfo.valuePtr [fieldInfo.valueSize] = saveChar;
  586.         if (elemArgv [1] == NULL)
  587.             goto errorExit;
  588.         if (elemArgv [1][0] == '\0')
  589.             newElement = NULL;
  590.         else
  591.             newElement = Tcl_Merge (2, elemArgv);
  592.         ckfree (elemArgv [1]);
  593.     } else
  594.         newElement = NULL;
  595.  
  596.     if (newElement == NULL) {
  597.         for (idx = fieldInfo.foundIdx; idx < fieldInfo.argc; idx++)
  598.              fieldInfo.argv [idx] = fieldInfo.argv [idx + 1];
  599.         fieldInfo.argc--;
  600.     } else
  601.         fieldInfo.argv [fieldInfo.foundIdx] = newElement;
  602.  
  603.     newList = Tcl_Merge (fieldInfo.argc, fieldInfo.argv);
  604.  
  605.     if (nameSeparPtr != NULL)
  606.          *nameSeparPtr = '.';
  607.     if (newElement != NULL)
  608.         ckfree (newElement);
  609.     ckfree ((char *) fieldInfo.argv);
  610.     return newList;
  611.  
  612. errorExit:
  613.     if (nameSeparPtr != NULL)
  614.          *nameSeparPtr = '.';
  615.     if (fieldInfo.argv != NULL)
  616.          ckfree ((char *) fieldInfo.argv);
  617.     return NULL;
  618. }
  619.  
  620. /*
  621.  *-----------------------------------------------------------------------------
  622.  *
  623.  * Tcl_KeyldelCmd --
  624.  *     Implements the TCL keyldel command:
  625.  *         keyldel listvar key
  626.  *
  627.  * Results:
  628.  *    Standard TCL results.
  629.  *
  630.  *----------------------------------------------------------------------------
  631.  */
  632. int
  633. Tcl_KeyldelCmd (clientData, interp, argc, argv)
  634.     ClientData  clientData;
  635.     Tcl_Interp *interp;
  636.     int         argc;
  637.     char      **argv;
  638. {
  639.     char  *keyedList, *newList;
  640.     int    listArgc, fieldIdx, idx;
  641.     char **listArgv;
  642.     char  *varPtr;
  643.  
  644.     if (argc != 3) {
  645.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
  646.                           " listvar key", (char *) NULL);
  647.         return TCL_ERROR;
  648.     }
  649.  
  650.     keyedList = Tcl_GetVar (interp, argv[1], TCL_LEAVE_ERR_MSG);
  651.     if (keyedList == NULL)
  652.         return TCL_ERROR;
  653.  
  654.     newList = Tcl_DeleteKeyedListField (interp, argv [2], keyedList);
  655.     if (newList == NULL)
  656.         return TCL_ERROR;
  657.  
  658.     varPtr = Tcl_SetVar (interp, argv [1], newList, TCL_LEAVE_ERR_MSG);
  659.     ckfree ((char *) newList);
  660.  
  661.     return (varPtr == NULL) ? TCL_ERROR : TCL_OK;
  662. }
  663.  
  664. /*
  665.  *-----------------------------------------------------------------------------
  666.  *
  667.  * Tcl_KeylgetCmd --
  668.  *     Implements the TCL keylget command:
  669.  *         keylget listvar ?key? ?retvar | {}?
  670.  *
  671.  * Results:
  672.  *    Standard TCL results.
  673.  *
  674.  *-----------------------------------------------------------------------------
  675.  */
  676. int
  677. Tcl_KeylgetCmd (clientData, interp, argc, argv)
  678.     ClientData  clientData;
  679.     Tcl_Interp *interp;
  680.     int         argc;
  681.     char      **argv;
  682. {
  683.     char   *keyedList;
  684.     char   *fieldValue;
  685.     char  **fieldValuePtr;
  686.     int     result;
  687.  
  688.     if ((argc < 2) || (argc > 4)) {
  689.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
  690.                           " listvar ?key? ?retvar | {}?", (char *) NULL);
  691.         return TCL_ERROR;
  692.     }
  693.     keyedList = Tcl_GetVar (interp, argv[1], TCL_LEAVE_ERR_MSG);
  694.     if (keyedList == NULL)
  695.         return TCL_ERROR;
  696.  
  697.     /*
  698.      * Handle request for list of keys, use keylkeys command.
  699.      */
  700.     if (argc == 2)
  701.         return Tcl_KeylkeysCmd (clientData, interp, argc, argv);
  702.  
  703.     /*
  704.      * Handle retrieving a value for a specified key.
  705.      */
  706.     if (argv [2] == '\0') {
  707.         interp->result = "null key not allowed";
  708.         return TCL_ERROR;
  709.     }
  710.     if ((argc == 4) && (argv [3][0] == '\0'))
  711.         fieldValuePtr = NULL;
  712.     else
  713.         fieldValuePtr = &fieldValue;
  714.  
  715.     result = Tcl_GetKeyedListField (interp, argv [2], keyedList,
  716.                                     fieldValuePtr);
  717.     if (result == TCL_ERROR)
  718.         return TCL_ERROR;
  719.  
  720.     /*
  721.      * Handle field name not found.
  722.      */
  723.     if (result == TCL_BREAK) {
  724.         if (argc == 3) {
  725.             Tcl_AppendResult (interp, "key \"", argv [2], 
  726.                               "\" not found in keyed list", (char *) NULL);
  727.             return TCL_ERROR;
  728.         } else {
  729.             interp->result = "0";
  730.             return TCL_OK;
  731.         }
  732.     }
  733.  
  734.     /*
  735.      * Handle field name found and return in the result.
  736.      */
  737.     if (argc == 3) {
  738.         Tcl_SetResult (interp, fieldValue, TCL_DYNAMIC);
  739.         return TCL_OK;
  740.     }
  741.  
  742.     /*
  743.      * Handle null return variable specified and key was found.
  744.      */
  745.     if (argv [3][0] == '\0') {
  746.         interp->result = "1";
  747.         return TCL_OK;
  748.     }
  749.  
  750.     /*
  751.      * Handle returning the value to the variable.
  752.      */
  753.     if (Tcl_SetVar (interp, argv [3], fieldValue, TCL_LEAVE_ERR_MSG) == NULL)
  754.         result = TCL_ERROR;
  755.     else
  756.         result = TCL_OK;
  757.     ckfree (fieldValue);
  758.     interp->result = "1";
  759.     return result;
  760. }
  761.  
  762. /*
  763.  *-----------------------------------------------------------------------------
  764.  *
  765.  * Tcl_KeylkeysCmd --
  766.  *     Implements the TCL keylkeys command:
  767.  *         keylkeys listvar ?key?
  768.  *
  769.  * Results:
  770.  *    Standard TCL results.
  771.  *
  772.  *-----------------------------------------------------------------------------
  773.  */
  774. int
  775. Tcl_KeylkeysCmd (clientData, interp, argc, argv)
  776.     ClientData  clientData;
  777.     Tcl_Interp *interp;
  778.     int         argc;
  779.     char      **argv;
  780. {
  781.     char   *keyedList, **keyesArgv;
  782.     int    result, keyesArgc;
  783.  
  784.     if ((argc < 2) || (argc > 3)) {
  785.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
  786.                           " listvar ?key?", (char *) NULL);
  787.         return TCL_ERROR;
  788.     }
  789.     keyedList = Tcl_GetVar (interp, argv[1], TCL_LEAVE_ERR_MSG);
  790.     if (keyedList == NULL)
  791.         return TCL_ERROR;
  792.  
  793.     /*
  794.      * If key argument is not specified, then argv [2] is NULL, meaning get
  795.      * top level keys.
  796.      */
  797.     result = Tcl_GetKeyedListKeys (interp, argv [2], keyedList, &keyesArgc,
  798.                                    &keyesArgv);
  799.     if (result == TCL_ERROR)
  800.         return TCL_ERROR;
  801.     if (result  == TCL_BREAK) {
  802.         Tcl_AppendResult (interp, "field name not found: \"",  argv [2],
  803.                           "\"", (char *) NULL);
  804.         return TCL_ERROR;
  805.     }
  806.  
  807.     Tcl_SetResult (interp, Tcl_Merge (keyesArgc, keyesArgv), TCL_DYNAMIC);
  808.     ckfree (keyesArgv);
  809.     return TCL_OK;
  810. }
  811.  
  812. /*
  813.  *-----------------------------------------------------------------------------
  814.  *
  815.  * Tcl_KeylsetCmd --
  816.  *     Implements the TCL keylset command:
  817.  *         keylset listvar key value ?key value...?
  818.  *
  819.  * Results:
  820.  *    Standard TCL results.
  821.  *
  822.  *-----------------------------------------------------------------------------
  823.  */
  824. int
  825. Tcl_KeylsetCmd (clientData, interp, argc, argv)
  826.     ClientData  clientData;
  827.     Tcl_Interp *interp;
  828.     int         argc;
  829.     char      **argv;
  830. {
  831.     char *keyedList, *newList, *prevList;
  832.     char *varPtr;
  833.     int   idx;
  834.  
  835.     if ((argc < 4) || ((argc % 2) != 0)) {
  836.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
  837.                           " listvar key value ?key value...?", (char *) NULL);
  838.         return TCL_ERROR;
  839.     }
  840.  
  841.     keyedList = Tcl_GetVar (interp, argv[1], 0);
  842.     
  843.     newList = keyedList;
  844.     for (idx = 2; idx < argc; idx += 2) {
  845.         prevList = newList;
  846.         newList = Tcl_SetKeyedListField (interp, argv [idx], argv [idx + 1],
  847.                                          prevList);
  848.         if (prevList != keyedList)
  849.             ckfree (prevList);
  850.         if (newList == NULL)
  851.            return TCL_ERROR;
  852.     }
  853.     varPtr = Tcl_SetVar (interp, argv [1], newList, TCL_LEAVE_ERR_MSG);
  854.     ckfree ((char *) newList);
  855.  
  856.     return (varPtr == NULL) ? TCL_ERROR : TCL_OK;
  857. }
  858.